home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IOInterface / deltaTimer.icl < prev    next >
Encoding:
Modula Implementation  |  1997-04-23  |  5.2 KB  |  176 lines  |  [TEXT/3PRM]
  1. implementation module deltaTimer;
  2.  
  3. import StdClass;
  4. import    StdInt;
  5. from    pointer            import LoadLong;
  6. from    OS_utilities    import Secs2Date, Secs2Time;
  7. import    timerDevice;
  8.  
  9.  
  10. TicksPerSecond :== 60;
  11.  
  12.  
  13. ::    CurrentTime
  14.     :==    (    !Int,        // hours        (0-23)
  15.             !Int,        // minutes        (0-59)
  16.             !Int        // seconds        (0-59)
  17.         );
  18. ::    CurrentDate
  19.     :==    (    !Int,        // year
  20.             !Int,        // month        (1-12)
  21.             !Int,        // day            (1-31)
  22.             !Int        // day of week    (1-7, Sunday=1, Saturday=7)
  23.         );
  24.  
  25. ::    DeltaTimerHandle *s :== (TimerHandle s) -> Toolbox
  26.                                             -> (TimerHandle s, !Toolbox);    // for local use
  27.  
  28.  
  29. //    Opening and Closing timers:
  30.  
  31. OpenTimer :: !(TimerDef s (IOState s)) !(IOState s) -> IOState s;
  32. OpenTimer tDef ioState
  33.     =    IOStateSetDevice (IOStateSetToolbox tb1 ioState2) (TimerSystemState tHs1);
  34.     where {
  35.         (tHs,    ioState1)    = IOStateGetTimerDevice ioState;
  36.         (tb,    ioState2)    = IOStateGetToolbox ioState1;
  37.         (tHs1,    tb1)        = OpenTimers [tDef] tHs tb;
  38.     };
  39.  
  40.  
  41. CloseTimer :: !TimerId !(IOState s) -> IOState s;
  42. CloseTimer id ioState
  43.     =    IOStateSetDevice ioState1 (TimerSystemState (TimerHandlesCloseTimer id tHs));
  44.     where {
  45.         (tHs, ioState1)    = IOStateGetTimerDevice ioState;
  46.     };
  47.  
  48. TimerHandlesCloseTimer :: !TimerId !(TimerHandles s) -> TimerHandles s;
  49. TimerHandlesCloseTimer id [tH=:(tDef, sampleTime) : tHs]
  50. |    id <> id`    = [tH : TimerHandlesCloseTimer id tHs];
  51.                 = tHs;
  52.     where {
  53.         (id`,_,_,_) = TimerDef_Attributes tDef;
  54.     };
  55. TimerHandlesCloseTimer _ tHs = tHs;
  56.  
  57.  
  58. //    Enabling and Disabling of TimerDevices:
  59.  
  60. EnableTimer :: !TimerId !(IOState s) -> IOState s;
  61. EnableTimer id ioState = SetTimers id (DeltaSetAbilityTimer Able) ioState;
  62.  
  63. DisableTimer :: !TimerId !(IOState s) -> IOState s;
  64. DisableTimer id ioState = SetTimers id (DeltaSetAbilityTimer Unable) ioState;
  65.  
  66.  
  67. //    Changing the TimerFunction and TimerInterval:
  68.  
  69. ChangeTimerFunction :: !TimerId !(TimerFunction s (IOState s)) !(IOState s) -> IOState s;
  70. ChangeTimerFunction id f ioState = SetTimers id (DeltaSetTimerFunction f) ioState;
  71.  
  72. SetTimerInterval :: !TimerId !TimerInterval !(IOState s) -> IOState s;
  73. SetTimerInterval id intervalTime ioState = SetTimers id (DeltaSetTimerInterval intervalTime) ioState;
  74.  
  75.  
  76. IOStateGetTimerDevice :: !(IOState s) -> (!TimerHandles s, !IOState s);
  77. IOStateGetTimerDevice ioState
  78.     =    (tHs, ioState1);
  79.     where {
  80.         (timers, ioState1)    = IOStateGetDevice ioState TimerDevice;
  81.         tHs                    = TimerSystemState_TimerHandles timers;
  82.     };
  83.  
  84. SetTimers :: !TimerId !(DeltaTimerHandle s) !(IOState s) -> IOState s;
  85. SetTimers id f ioState
  86.     =    IOStateSetDevice (IOStateSetToolbox tb1 ioState2) (TimerSystemState tHs1);
  87.     where {
  88.         (tHs,    ioState1)    = IOStateGetTimerDevice ioState;
  89.         (tb,    ioState2)    = IOStateGetToolbox ioState1;
  90.         (tHs1,    tb1)        = TimerHandlesSetTimer id f tHs tb;
  91.     };
  92.  
  93. TimerHandlesSetTimer :: !TimerId !(DeltaTimerHandle s) !(TimerHandles s) !Toolbox
  94.     ->    (!TimerHandles s, !Toolbox);
  95. TimerHandlesSetTimer id dt [tH=:(tDef, sampleTime) : tHs] tb
  96. |    id == id`    = ([tH1 : tHs ], tb1);
  97.                 = ([tH  : tHs1], tb2);
  98.     where {
  99.         (id`,_,_,_)    = TimerDef_Attributes tDef;
  100.         (tHs1,tb2)    = TimerHandlesSetTimer id dt tHs tb;
  101.         (tH1, tb1)    = dt tH tb;
  102.     };
  103. TimerHandlesSetTimer _ _ tHs tb = (tHs,tb);
  104.  
  105. DeltaSetAbilityTimer :: !SelectState !(TimerHandle s) !Toolbox -> (!TimerHandle s, !Toolbox);
  106. DeltaSetAbilityTimer able (tDef,_) tb
  107.     =    ((TimerDef_SetAbility tDef able, time), tb1);
  108.     where {
  109.         (time, tb1) = TickCount tb;
  110.     };
  111.  
  112. DeltaSetTimerFunction :: !(TimerFunction s (IOState s)) !(TimerHandle s) !Toolbox
  113.     ->    (!TimerHandle s, !Toolbox);
  114. DeltaSetTimerFunction f (tDef, sampleTime) tb = ((TimerDef_SetFunction tDef f, sampleTime), tb);
  115.  
  116. DeltaSetTimerInterval :: !TimerInterval !(TimerHandle s) !Toolbox -> (!TimerHandle s, !Toolbox);
  117. DeltaSetTimerInterval intervalTime (tDef, sampleTime) tb
  118.     =    ((TimerDef_SetInterval tDef (Max 0 intervalTime), sampleTime), tb);
  119.  
  120.  
  121. //    Suspend the interaction for a number of ticks.
  122.  
  123. Wait :: !TimerInterval x -> x;
  124. Wait nrticks x = WaitTicks time nrticks tb x;
  125.     where {
  126.         (time,tb) = TickCount NewToolbox;
  127.     };
  128.  
  129. UWait :: !TimerInterval *x -> *x;
  130. UWait nrticks ux = WaitTicks time nrticks tb ux;
  131.     where {
  132.         (time,tb) = TickCount NewToolbox;
  133.     };
  134.  
  135. WaitTicks :: !Int !Int !Toolbox .x -> .x;
  136. WaitTicks ticks nr tb x
  137. |    time - ticks >= nr    = x;
  138.                         = WaitTicks ticks nr tb1 x;
  139.     where {
  140.         (time,tb1) = TickCount tb;
  141.     };
  142.  
  143.  
  144. //    Getting the blinking time:
  145.  
  146. GetTimerBlinkInterval :: !(IOState s) -> (!TimerInterval, !IOState s);
  147. GetTimerBlinkInterval ioState = IOStateAccessToolbox (LoadLong CaretTime) ioState;
  148.  
  149.  
  150. //    Get current time and date:
  151.  
  152. GetCurrentTime :: !(IOState s) -> (!CurrentTime, !IOState s);
  153. GetCurrentTime ioState = IOStateAccessToolbox loadTime ioState;
  154.  
  155. loadTime :: !Toolbox -> (!CurrentTime, !Toolbox);
  156. loadTime tb
  157.     =    ((hours,minutes,seconds), tb2);
  158.     where {
  159.         (timeLoc,tb1)                = LoadLong  TimeLoc tb;
  160.         (hours,minutes,seconds,tb2)    = Secs2Time timeLoc tb1;
  161.     };
  162.  
  163. GetCurrentDate :: !(IOState s) -> (!CurrentDate, !IOState s);
  164. GetCurrentDate ioState = IOStateAccessToolbox loadDate ioState;
  165.  
  166. loadDate :: !Toolbox -> (!CurrentDate, !Toolbox);
  167. loadDate tb
  168.     =    ((year,month,day,dayOfWeek),tb2);
  169.     where {
  170.         (timeLoc,tb1)                    = LoadLong  TimeLoc tb;
  171.         (year,month,day,dayOfWeek,tb2)    = Secs2Date timeLoc tb1;
  172.     };
  173.  
  174. CaretTime    :== 756;    // The address which contains the LongInt of the caret-time.
  175. TimeLoc        :== 524;    // The address which contains the time since 1-1-1904 (midnight).
  176.